home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d26
/
cattest.arc
/
PROTOTYP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-07-01
|
14KB
|
500 lines
{$A+,B-,D+,E+,F+,G-,I+,L+,N-,O+,R-,S-,V+,X-}
{$M 16384,0,655360}
{$UNDEF Watch_Student} {used to record student answers to disk for "analysis"}
{$UNDEF Overlaying}
{$IFNDEF Overlaying}
PROGRAM {substitute next line}
prototst;
{ an example of a simple question without formulas }
{$ELSE}
unit PROTOovr;
interface
function PROTO(VAR grade : Integer):Boolean;
implementation
{$ENDIF}
USES
Crt,DOS,WIN,timestuf,UTILITY,EVAL3;
FUNCTION {substitute next line}
PROTO
(VAR grade : Integer)
: Boolean; { when called, return True if properly answered
returns False when help was used and the
question resumed}
TYPE
DebugLinePtr = ^Debug_lines;
Debug_Lines = RECORD
line : STRING; {these will be written into a debug window}
next : DebugLinePtr;
END;
errorPtr = ^Wrong_Answers;
Wrong_Answers = RECORD
value : real; {each entry is a teacher chosen error value}
remark : STRING; {each entry is a teacher chosen response}
Next : errorPtr;
END;
TitleStrPtr = ^TitleStr;
WinRecPtr = ^WinRec;
WinRec = RECORD
Next: WinRecPtr;
State: WinState;
Title : TitleStrPtr;
TitleAttr, FrameAttr: Byte;
Buffer: Pointer;
END;
CONST
variable : char = #0; { set to non character if numbers to be read }
tolerance : real = 0.1; { set to reasonable discriminatory level
as fraction of true answer }
VAR
OutFile : TEXT;
CONST
ProgName_String : STRING = {substitute next line}
'PROTO';
VAR
SaveTextAttr : Byte;
OldQuestionFile : Text;
Choice_Line,
comment_string, {string for student responses }
answer : STRING; { Student response to main question }
true_answer,
Value : real; { Returned value of Student response }
Err,ErrPos : integer; {Required Error Flags for EVAL }
ErrMsg: STRING;
Problem_Right,
Question_Done : Boolean;
My_Choice : Char;
GenTempPtr,TempPtr,RootErrorPtr : errorPtr;
TempDebugLinePtr,GenTempDebugPtr,
RootDebugLinePtr : DebugLinePtr;
TopWindow : WinRecPtr;
WindowCount : Integer;
Color : Byte;
pswd : Char;
question2 : STRING;
PROCEDURE ActiveWindow(Active: Boolean);
BEGIN
IF TopWindow <> NIL
THEN
BEGIN
UnFrameWin;
WITH TopWindow^ DO
IF Active
THEN
FrameWin(Title^, DoubleFrame, TitleAttr, FrameAttr)
ELSE
FrameWin(Title^, SingleFrame, FrameAttr, FrameAttr);
END;
END;
PROCEDURE OpenWindow(X1, Y1, X2, Y2: Byte; T: TitleStr;
TAttr, FAttr: Byte);
VAR
W: WinRecPtr;
BEGIN
GoToXY(38,1);WriteLn('WAIT');
ActiveWindow(False);
New(W);
WITH W^ DO
BEGIN
Next := TopWindow;
SaveWin(State);
GetMem(Title, Length(T) + 1);
Title^ := T;
TitleAttr := TAttr;
FrameAttr := FAttr;
Window(X1, Y1, X2, Y2);
GetMem(Buffer, WinSize);
ReadWin(Buffer^);
FrameWin(T, DoubleFrame, TAttr, FAttr);
END;
TopWindow := W;
Inc(WindowCount);
END;
PROCEDURE CloseWindow;
VAR
W: WinRecPtr;
BEGIN
IF TopWindow <> NIL
THEN
BEGIN
W := TopWindow;
WITH W^ DO
BEGIN
UnFrameWin;
WriteWin(Buffer^);
FreeMem(Buffer, WinSize);
FreeMem(Title, Length(Title^) + 1);
RestoreWin(State);
TopWindow := Next;
END;
Dispose(W);
ActiveWindow(True);
Dec(WindowCount);
GoToXY(38,1);WriteLn(' ');
END;
END;
PROCEDURE reverse(text_in:STRING);
BEGIN
SaveTextAttr := TextAttr;
TextAttr := Black + LightGray*16;
OpenWindow(1,1,80,4,text_in,LightGray*16,LightGray);
TextAttr := LightGray;
ClrScr;
END;
PROCEDURE Normal;
BEGIN
CloseWindow;
TextAttr := SaveTextAttr;
END;
PROCEDURE Help;
BEGIN
Reverse('HELP');
Our_Write(1,1,'There is no help available for this question.');
Pause(1,2,'Press any key to continue.');
Normal;
END;
FUNCTION Choice: Char;
VAR
s : STRING;
BEGIN
Reverse('MAIN MENU');
Our_Write(1,1,'[F1]:Calculator [F2]:Answer [F3]:Help [F4]:Comment [F5]:Next Question' )
;
Our_Write(1,2,'[F6]:Quit Exam ' );
Choice := Read_Key;
Normal;
END;
FUNCTION Is_The_STUDENT_Answer_Right(prompt:STRING;
correct_value:real): boolean;
PROCEDURE Wrong_Answer;
VAR
k_error: integer;
temp_value : real;
TEMP_REMARK : STRING;
BEGIN
TempPtr := RootErrorPtr;
Reverse('Help after incorrect answer.');
WHILE TempPtr <> NIL DO
BEGIN
IF abs(TempPtr^.value-value) <= abs(tolerance*true_answer)
THEN
BEGIN
Our_Write(1,1,TempPtr^.remark);
Pause(1,2,'Press any key to continue.');
Normal;
exit;
END;
{ if we exhaust all guesses about the error, then do the following}
TempPtr := TempPtr^.Next;
END;
Our_write(1,1,'Unable to interpret your error. Returning to question.');
Pause(1,2,'Press any key to continue.');
Normal;
END; {of Wrong_Answer}
BEGIN
Question_Done := False;
REPEAT
REPEAT
Reverse('ANSWER');
Our_Write(1,1,
'Escape to leave, [0 thru 9, ., +, -, /, *, arrows], '+#27#217+
' key to compute.'
);
Our_Write(1,2,' ');
Read_Float_Masked
(1,
2,
3, {number of digits}
Prompt,
False,
value);
Normal;
{$IFDEF Watch_Student}
WriteLn(OutFile,Time_Stamp,'Answer input->',value);
{$ENDIF}
IF Escape_struck
THEN
BEGIN
WHILE
YesNo(1,2,'Do you want to abandon this question (y,n,Y,N)?') DO
BEGIN
Is_The_STUDENT_Answer_Right := False;
{ student could not do this question }
Question_Done := True;
{ abandon question, not necessarily Watch_Student }
Grade := -1; {Proctor Convention}
{$IFDEF Watch_Student}
WriteLn(OutFile,'Student abandoned problem');
{$ENDIF}
exit;
END;
END;
UNTIL NOT Escape_Struck;
IF abs(value - true_answer) <= abs(tolerance*true_answer)
THEN
BEGIN
Is_The_STUDENT_Answer_Right := True;
Question_Done := True;
exit;
END
ELSE
IF YesNo(1,2,'Do you want help?')
THEN
Wrong_Answer;
UNTIL (Question_Done);
END {of Is_The_Student_Right};
PROCEDURE Initialize;
BEGIN
Randomize;
TopWindow := nil;
WindowCount := 0;
Question_Done := False;
Problem_Right := False;
{$IFDEF Watch_Student}
Assign(OutFile,ProgName_String+'.$$$');
if FileExists(ProgName_String+'$$$')
then Append(OutFile)
else ReWrite(OutFile);
{$ENDIF}
END {of Initialize};
PROCEDURE real_chooser(prompt:STRING;correct_answer:real);
VAR k_line : integer;
BEGIN
REPEAT
My_Choice := Choice;
GoToXY(1,25);
ClrEol;
CASE My_Choice OF
PF1 : {Calculator}
BEGIN
Reverse('CALCULATOR');
Our_Write(1,1,
'Escape to leave, [0 thru 9, ., +, -, /, *]'+#27#217+
' key to compute.'
);
answer := Read_equation(
1,2,80,'Enter an expression(max length = 80)',[]);
IF NOT Escape_struck
THEN
BEGIN
{$IFDEF Watch_Student}
WriteLn(OutFile,Time_Stamp,
'Student expression follows:',answer);
{$ENDIF}
Evaluate(answer,Value,ErrPos,ErrMsg);
IF ErrMsg <> 'O.K.'
THEN
BEGIN
Our_Write
(1,1,'There has been an error in interpreting your answer.'
);
Pause(1,2,'Press any key to continue.');
END
ELSE
BEGIN
GoToXY(1,1);
Write('Calculator Result = ',Value);
ClrEol;
{$IFDEF Watch_Student}
WriteLn(OutFile,Time_Stamp,
'*+-/*+-/ Calculator Result = ',Value);
{$ENDIF}
Pause(1,2,'Press any key to continue.');
END;
END;
Normal;
END;
PF2 : {Enter an answer}
Problem_Right :=
Is_The_STUDENT_Answer_Right('ANSWER = ',correct_answer);
PF3 : {Get Help}
Help;
PF4 : {Comment, this is not a full fledged editor, and may
need improvement}
BEGIN
Reverse('COMMENT');
Our_Write(1,1,
'Enter any characters (no editing available). End with ENTER.');
ReadLn(comment_string);
Normal;
{$IFDEF Watch_Student}
WriteLn(OutFile,Time_Stamp,
'student comment: ', comment_string);
{$ENDIF}
END;
PF5 : {quit this question}
BEGIN
{$IFDEF Watch_Student}
WriteLn(OutFile,Time_Stamp,
'Student abandoned problem, continuing to next.');
WriteLn(OutFile,'Closing file '+ProgName_String);
Close(OutFile);
{$ENDIF}
Question_Done := true;
Grade := -1; {this is the halt flag for terminating
a question }
END;
PF6 : {quit the examination}
BEGIN
{$IFDEF Watch_Student}
WriteLn(OutFile,Time_Stamp,
'Student abandoned examination.');
WriteLn(OutFile,'Closing file '+ProgName_string);
Close(OutFile);
{$ENDIF}
Question_Done := true;
Grade := -2; {this is the halt flag for terminating
the examination }
END;
PF10 :
BEGIN {window with debug information}
SaveTextAttr := TextAttr;
TextAttr := Black + LightGray*16;
OpenWindow(2,10,78,24,'DEBUG',LightGray*16,LightGray);
TextAttr := LightGray;
ClrScr;
REPEAT
pswd := Read_Key;
UNTIL pswd = '\'; {change this if students discover it}
TempDebugLinePtr := RootDebugLinePtr;
while TempDebugLinePtr^.next <> NIL DO
BEGIN
WriteLn( TempDebugLinePtr^.line);
TempDebugLinePtr := TempDebugLinePtr^.next;
END;
WriteLn( TempDebugLinePtr^.line); {last line}
Pause(1,wherey+1,'Press a key to exit');
Normal;
END;
END; {case}
UNTIL Question_Done;
END {of real_chooser};
{$I INITQUES.IN1} {all the exam specific material should be in here}
BEGIN { MAIN question }
ClrScr;
question2 := '';
Initialize;
Init_question;
{ question posing section }
PoseQuestion(5,question);
(* use the next only if length of question is > 255 *)
PoseQuestion(7,question2);
Real_Chooser(Choice_Line,true_answer);
{this problem requires a "real" answer'}
IF (Question_Done AND Problem_Right)
THEN Grade := 100;
{substitute next line}
PROTO
:= Question_Done; {which is the right usage?
pass grade back in case student
quit the exam, remember that
Problem_Right has the value true
if problem was done correctly.}
GenTempPtr := RootErrorPtr; {clean up errors from heap so that
no memory problems occur}
TempPtr := GenTempPtr^.Next;
Dispose(GenTempPtr);
WHILE TempPtr <> NIL DO
BEGIN
GenTempPtr := TempPtr^.Next;
Dispose(TempPtr);
TempPtr := GenTempPtr;
END;
GenTempDebugPtr := RootDebugLinePtr; {clean up debug from heap so that
no memory problems occur}
TempDebugLinePtr := GenTempDebugPtr^.Next;
Dispose(GenTempDebugPtr);
WHILE TempDebugLinePtr <> NIL DO
BEGIN
GenTempDebugPtr := TempDebugLinePtr^.Next;
Dispose(TempDebugLinePtr);
TempDebugLinePtr := GenTempDebugPtr;
END;
IF Problem_Right
THEN Pause(1,25,'Question Done Correctly, Press any key.')
ELSE Pause(1,25,'Exiting Question, Press any key.');
ClrScr;
END {substitute next line}
{PROTO};
{$IFNDEF Overlaying}
VAR
Done : Boolean;
Grade : Integer;
BEGIN {this is the MAIN entry for testing the question as a function}
Escape_struck := False;
REPEAT
IF Escape_struck
THEN noise(Acknowledge);
Done := {substitute next line}
PROTO
(grade);{this is a function call to the question begin debugged}
UNTIL Done;
{Record student's success now}
{$ENDIF}
END.